home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / stay42.zip / STAYWNDO.341 < prev    next >
Text File  |  1986-06-07  |  16KB  |  376 lines
  1. {**********************************************************************}
  2. {                         W I N D O . I N C                            }
  3. {                     "...but I dont do floors !"                      }
  4. {**********************************************************************}
  5. {                 Kloned and Kludged by Lane Ferris                    }
  6. {                     -- The Hunters Helper --                         }
  7. {               Original Copyright 1984 by Michael A. Covington        }
  8. {               Modifications by Lynn Canning 9/25/85                  }
  9. {                 1) Foreground and Background colors added.           }
  10. {                    Monochrome monitors are automatically set         }
  11. {                    to white on black.                                }
  12. {                 2) Multiple borders added.                           }
  13. {                 3) TimeDelay procedure added.                        }
  14. {               Requirements: IBM PC or close compatible.              }
  15. {----------------------------------------------------------------------}
  16. { To make a window on the screen, call the procedure                   }
  17. {      MkWin(x1,y1,x2,y2,FG,BG,BD);                                    }
  18. {   The x and y coordinates define the window placement and are the    }
  19. {   same as the Turbo Pascal Window coordinates.                       }
  20. {   The border parameters (BD) are 0 = No border                       }
  21. {                                  1 = Single line border              }
  22. {                                  2 = Double line border              }
  23. {                                  3 = Double Top/Bottom Single sides  }
  24. {   The foreground (FG) and background (BG) parameters are the same    }
  25. {   values as the corresponding Turbo Pascal values.                   }
  26. {                                                                      }
  27. { The maximum number of windows open at one time is set at five        }
  28. { (see MaxWin=5).  This may be set to greater values if necessary.     }
  29. {                                                                      }
  30. { After the window is made, you must write the text desired from the   }
  31. { calling program.  Note that the usable text area is actually 1       }
  32. { position smaller than the window coordinates to allow for the border.}
  33. { Hence, a window defined as 1,1,80,25 would actually be 2,2,79,24     }
  34. { after the border is created.  When writing to the window in your     }
  35. { calling program, the textcolor and backgroundcolor may be changed as }
  36. { desired by using the standard Turbo Pascal commands.                 }
  37. {                                                                      }
  38. { To return to the previous screen or window, call the procedure       }
  39. {      RmWin;                                                          }
  40. {                                                                      }
  41. { The TimeDelay procedure is invoked from your calling program.  It    }
  42. { is similar to the Turbo Pascal DELAY except DELAY is based on clock  }
  43. { speed whereas TimeDelay is based on the actual clock.  This means    }
  44. { that the delay will be the same duration on all systems no matter    }
  45. { what the clock speed.                                                }
  46. { The procedure could be used for an error condition as follows:       }
  47. {     MkWin          - make an error message window                    }
  48. {     Writeln        - write error message to window                   }
  49. {     TimeDelay(5)   - leave window on screen 5 seconds                }
  50. {     RmWin          - remove error window                             }
  51. {     cont processing                                                  }
  52. {----------------------------------------------------------------------}
  53.  
  54. Const
  55.  
  56.       InitDone :boolean = false ;      { Initialization switch   }
  57.  
  58.       On     = True ;
  59.       Off    = False ;
  60.       VideoEnable = $08;               { Video Signal Enable Bit }
  61.       Bright = 8;                      { Bright Text bit}
  62.       Mono   = 7;                      {MonoChrome Mode}
  63.  
  64. Type
  65.      Imagetype  = array [1..4000] of char;  { Screen Image in the heap    }
  66.      WinDimtype = record
  67.                     x1,y1,x2,y2: integer
  68.                   end;
  69.  
  70.      Screens    = record              { Save Screen Information     }
  71.                    Image: Imagetype;  { Saved screen Image }
  72.                    Dim:   WinDimtype; { Saved Window Dimensions }
  73.                    x,y:   integer;    { Saved cursor position }
  74.                   end;
  75.  
  76.  
  77.  Var
  78.  
  79.   Win:                                { Global variable package }
  80.     record
  81.       Dim:    WinDimtype;             { Current Window Dimensions }
  82.       Depth:  integer;
  83.                    { MaxWin should be included in your program }
  84.                    { and it should be the number of windows saved }
  85.                    { at one time }
  86.                    { It should be in the const section of your program }
  87.       Stack:  array[1..MaxWin] of ^Screens;
  88.  
  89.     end;
  90.  
  91.   Crtmode     :byte      absolute $0040:$0049; {Crt Mode,Mono,Color,B&W..}
  92.   Crtwidth    :byte      absolute $0040:$004A; {Crt Mode Width, 40:80 .. }
  93.   Monobuffer  :Imagetype absolute $B000:$0000; {Monochrome Adapter Memory}
  94.   Colorbuffer :Imagetype absolute $B800:$0000; {Color Adapter Memory     }
  95.   CrtAdapter  :integer   absolute $0040:$0063; { Current Display Adapter }
  96.   VideoMode   :byte      absolute $0040:$0065; { Video Port Mode byte    }
  97.   TurboCrtMode: byte     absolute  Dseg:6;     {Turbo's Crt Mode byte    }
  98.   Video_Buffer:integer;                        { Record the current Video}
  99.   Delta,
  100.   x,y         :integer;
  101.  
  102. {------------------------------------------------------------------}
  103. {                     Delay for  X seconds                         }
  104. {------------------------------------------------------------------}
  105.  
  106. procedure TimeDelay (hold : integer);
  107. type
  108.   RegRec =                                { The data to pass to DOS }
  109.     record
  110.       AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
  111.     end;
  112. var
  113.   regs:regrec;
  114.   ah, al, ch, cl, dh:byte;
  115.   sec               :string[2];
  116.   result, secn, error, secn2, diff :integer;
  117.  
  118. begin
  119.   ah := $2c;                       {Get Time-Of-Day from DOS}
  120.   with regs do                     {Will give back Ch:hours }
  121.                                    {Cl:minutes,Dh:seconds   }
  122.     ax := ah shl 8 + al;           {Dl:hundreds             }
  123.   intr($21,regs);
  124.  
  125.   with regs do
  126.     str(dx shr 8:2, sec);          {Get seconds      }
  127.                                    {with leading null}
  128.   if (sec[1] = ' ') then
  129.     sec[1]:= '0';
  130.   val(sec, secn, error);           {Conver seconds to integer}
  131.   repeat                           { stay in this loop until the time }
  132.      ah := $2c;                    { has expired }
  133.      with regs do
  134.         ax := ah shl 8 + al;
  135.      intr($21,regs);               {Get current time-of-day}
  136.  
  137.      with regs do                  {Normalize to Char}
  138.         str(dx shr 8:2, sec);
  139.      if (sec[1] = ' ') then
  140.         sec[1]:= '0';
  141.      val(sec, secn2, error);       {Convert seconds to integer}
  142.      diff := secn2 - secn;         {Number of elapsed seconds}
  143.      if diff < 0 then            { we just went over the minute }
  144.         diff := diff + 60;       { so add 60 seconds }
  145.   until diff > hold;             { has our time expired yet }
  146. end; { procedure TimeDelay }
  147.  
  148. {------------------------------------------------------------------}
  149. {          Get Absolute postion of Cursor into parameters x,y      }
  150. {------------------------------------------------------------------}
  151. Procedure Get_Abs_Cursor (var x,y :integer);
  152.   Var
  153.       Active_Page  : byte absolute $0040:$0062;  { Current Video Page Index}
  154.       Crt_Pages    : array[0..7] of integer absolute $0040:$0050 ;
  155.  
  156.    Begin
  157.  
  158.       X := Crt_Pages[active_page];     { Get Cursor Position       }
  159.       Y := Hi(X)+1;                    { Y get Row                 }
  160.       X := Lo(X)+1;                    { X gets Col position       }
  161.    End;
  162. {------